home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Amiga-E
/
E_v3.2a
/
Src
/
Gfx
/
RewriteGfx.e
< prev
next >
Wrap
Text File
|
1992-09-02
|
7KB
|
170 lines
/* Using a (forth-featured) rewrite-grammar to plot
recursive (turtle) graphics
a graphics plotting system that uses rewrite-grammars. the idea is
that the description of an image (much like some fractals i know)
is denoted in a grammar, which is then used to plot the gfx.
the system uses turtlegraphics for plotting, and some forth-heritage
for additional power. the program is not meant to actually "used";
change to different graphics with the CONST in the sources, to
see what the grammars do.
next to normal context-free grammars like S->ASA,
following (forth-lookalike) turtle commands may be used:
up pen up
down pen down
<x> <y> set set absolute position
<d> move move relative to last coordinates, distance <d>
in direction <angle>, draw line if pen is down
<angle> degr set initial angle
<angle> rol rotate relative counter-clockwise (left)
<angle> rol rotate relative clockwise (right)
<nr> col set colour to plot with
push save x/y/angle/pen status at this point on stack
pop restore status
dup duplicate last item on stack
<int> <int> add add two integers
<int> <int> sub substract two integers (first-second)
<int> <int> mul multiply two integers
<int> <int> div divide two integers
<int> <int> eq see if two integers are equal
<int> <int> uneq see if two integers are unequal
<bool> if <s> end conditional statement */
CONST CURGR=9 /* SET THIS ONE TO 0-11 TO GET A DIFFERENT GRAMMAR */
ENUM S=1000, A,B,C,D,E,F,G, Z
CONST R=20
DEF gr[20]:ARRAY OF LONG,win,stack[5000]:ARRAY OF LONG,sp=NIL:PTR TO LONG,
penf=TRUE,x=50.0,y=60.0,col=2,degr=0.0
/* don't build your own grammars if you don't know *exactly* what
you're doing. there are no error checks. */
PROC initgrammar()
gr[0]:=[[S, A,A,A], /* lotsa triangles */
[A, 25,"ror",D,D,D,D,D,D,"up",50,"move","down"],
[D, F,G,F,G,F,G,E],
[E, "up",R,"move",30,"rol",5,"move",30,"rol","down"],
[F, R,"move"],
[G, 120,"rol"]]
gr[1]:=[[S, 100,20,"set",30,A], /* shell */
[A, "dup","move",1,"sub","dup",0,"uneq","if",B,"end"],
[B, "dup","dup",90,"ror","move",180,"ror","up","move",
90,"ror","down",20,"ror",A]] /* some figure */
gr[2]:=[[S, B,B,B,B,B,B,B,B,B,B,B,B,B,B,B],
[B, A,A,A,A,A,A,A,A,-10,"move"],
[A, "down",80,"move",183,"rol"]]
gr[4]:=[[S, 160,188,"set",90,"degr",30,A,1,"col",1,"move"], /* 45 tree */
[A, "dup","dup","move","if","dup",115,"mul",150,"div","dup",45,
"rol",A,90,"ror",A,45,"rol","end",180,"rol","move",180,"rol"]]
gr[5]:=[[S, 160,188,"set",90,"degr",60,A,1,"col",1,"move"], /* thin tree */
[A, "dup","dup","move","if","dup",100,"mul",150,"div","dup",40,
"rol",A,69,"ror",196,"mul",191,"div",A,29,"rol","end",180,
"rol","move",180,"rol"]]
gr[6]:=[[S, 160,188,"set",91,"degr",36,A,1,"col",1,"move"], /* slow tree */
[A, "dup","dup","move","if","dup",120,"mul",150,"div","dup",20,
"rol",A,40,"ror",170,"mul",166,"div",A,20,"rol","end",180,
"rol","move",180,"rol"]]
gr[7]:=[[S, 200,160,"set",90,"degr",30,A,1,"col",1,"move"],/* swirl tree */
[A, "dup","dup","move","if","dup",135,"mul",150,"div","dup",29,
"rol",A,50,"ror",21,"mul",30,"div",A,21,"rol","end",180,
"rol","move",180,"rol"]]
gr[8]:=[[S, 160,160,"set",90,"degr",36,A,1,"col",1,"move"], /* frond */
[A, "dup","dup","move","if","dup",112,"mul",150,"div","dup",35,
"rol",A,120,"ror",A,85,"rol","end",180,"rol","move",180,"rol"]]
gr[9]:=[[S, 160,188,"set",90,"degr",32,A,1,"col",1,"move"], /* nice tree */
[A, "dup","dup","move","if","dup",85,"mul",150,"div","dup","dup",
25,"rol",A,25,"ror",150,"mul",100,"div",A,
25,"ror",A,25,"rol","end",180,"rol","move",180,"rol"]]
gr[10]:=[[S, 160,188,"set",90,"degr",60,A,1,"col",1,"move"],/* sahara */
[A, "dup","dup","move","if","dup",95,"mul",150,"div","dup",15,
"rol",A,30,"ror",A,15,"rol","end",180,"rol","move",180,"rol"]]
gr[11]:=[[S, 134,188,"set",90,"degr",44,A,
184,174,"set",94,"degr",36,A,
158,191,"set",88,"degr",48,A,
206,168,"set",90,"degr",14,A], /* sea oats */
[A, "dup","dup","move","if","dup",60,"mul",150,"div","dup",
114,"rol",A,2,"mul",100,"ror",A,14,"ror","end",180,"rol",
"move",180,"rol"]]
ENDPROC
PROC main()
win:=OpenW(20,20,600,200,$200,$F,'Rewrite Graphics',NIL,1,NIL)
IF win=NIL
WriteF('Could not open window!\n')
ELSE
initgrammar()
sp:=stack+400 /* temp */
dorewrite(S)
IF sp<>(stack+400) THEN WriteF('WARNING: stack not clean\n')
WaitIMessage(win)
CloseW(win)
ENDIF
ENDPROC
PROC dorewrite(startsym)
DEF i:PTR TO LONG
ForAll({i},gr[CURGR],`IF i[0]=startsym THEN dolist(i) ELSE 0)
ENDPROC
PROC dolist(list:PTR TO LONG)
DEF r=1,sym,rada,cosa,sina,xd,yd,xo,yo,a
WHILE r<ListLen(list)
sym:=list[r++]
IF sym<S
sp[]++:=sym
ELSE
IF sym>Z
SELECT sym
CASE "down"; penf:=TRUE
CASE "up"; penf:=FALSE
CASE "set"; y:=sp[]--!; x:=sp[]--!
CASE "col"; col:=sp[]--
CASE "rol"; degr:=sp[]--!+degr
CASE "ror"; degr:=-sp[]--!+degr
CASE "degr"; degr:=sp[]--!
CASE "push"; sp[]++:=x; sp[]++:=y; sp[]++:=degr; sp[]++:=penf
CASE "pop"; sp[]--:=penf; sp[]--:=degr; sp[]--:=y; sp[]--:=x
CASE "dup"; a:=sp[]--; sp[]++:=a; sp[]++:=a
CASE "add"; sp[]++:=sp[]--+sp[]--
CASE "sub"; a:=sp[]--; sp[]++:=sp[]---a
CASE "mul"; sp[]++:=sp[]--*sp[]--
CASE "div"; a:=sp[]--; sp[]++:=sp[]--/a
CASE "eq"; sp[]++:=sp[]--=sp[]--
CASE "uneq"; sp[]++:=sp[]--<>sp[]--
CASE "end"; NOP
CASE "if"; IF sp[]--=FALSE THEN WHILE list[r++]<>"end" DO NOP
CASE "move"
xo:=x; yo:=y; x:=sp[]--!+x
rada:=!degr/180.0*3.14159
cosa:=Fcos(rada); sina:=Fsin(rada)
xd:=!x-xo; yd:=!y-yo
x:=!xo+(!xd*cosa)-(!yd*sina)
y:=!yo+(!yd*cosa)-(!xd*sina)
IF penf THEN Line(!xo!*2,!yo!,!x!*2,!y!,col)
DEFAULT; WriteF('WARNING: unknown opcode\n')
ENDSELECT
ELSE
dorewrite(sym)
ENDIF
ENDIF
ENDWHILE
ENDPROC